home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / gui-ver4 / newgui.cls next >
Encoding:
Visual Basic class definition  |  1998-10-06  |  13.8 KB  |  367 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "X_gui"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Private Const BDR_RAISEDOUTER = &H1
  11. Private Const BDR_SUNKENOUTER = &H2
  12. Private Const BDR_RAISEDINNER = &H4
  13. Private Const BDR_SUNKENINNER = &H8
  14. Private Const BDR_OUTER = &H3
  15. Private Const BDR_INNER = &HC
  16. Private Const BDR_RAISED = &H5
  17. Private Const BDR_SUNKEN = &HA
  18.  
  19. Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
  20. Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
  21. Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
  22. Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
  23.  
  24. Private Const BF_LEFT = &H1
  25. Private Const BF_TOP = &H2
  26. Private Const BF_RIGHT = &H4
  27. Private Const BF_BOTTOM = &H8
  28. Private Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
  29. Private Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
  30. Private Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
  31. Private Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
  32. Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  33. Private Const BF_DIAGONAL = &H10
  34. Private Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
  35. Private Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
  36. Private Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
  37. Private Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)
  38. Private Const BF_MIDDLE = &H800    ' Fill in the middle.
  39. Private Const BF_SOFT = &H1000     ' Use for softer buttons.
  40. Private Const BF_ADJUST = &H2000   ' Calculate the space left over.
  41. Private Const BF_FLAT = &H4000     ' For flat rather than 3-D borders.
  42. Private Const BF_MONO = &H8000     ' For monochrome borders.
  43. Rem --edge
  44.  
  45. Private Const TA_CENTER = 6         '//ExtTextout Consts
  46. Private Const ETO_OPAQUE = 2
  47. Private Const ETO_GRAYED = 1
  48. Private Const ETO_CLIPPED = 4
  49.  
  50. Private Type POINTAPI
  51.         X As Long
  52.         Y As Long
  53. End Type
  54.  
  55. Private Type Rect
  56.         Left As Long
  57.         Top As Long
  58.         Right As Long
  59.         Bottom As Long
  60. End Type
  61.  
  62. Private Type Size
  63.         cx As Long
  64.         cy As Long
  65. End Type
  66.  
  67. Public OwnerForm As Form
  68.  
  69. Rem ------ Window Stuff
  70. Private Declare Function SetWindowPos Lib "user32" (ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  71. Private Declare Function GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As Rect) As Long
  72. Private Declare Function DeferWindowPos Lib "user32" (ByVal hWinPosInfo As Long, ByVal Hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  73. Private Const SWP_NOZORDER = &H4
  74. Private Const SWP_NOACTIVATE = &H10
  75. Private Const SWP_SHOWWINDOW = &H40
  76. Private Const SWP_NOMOVE = &H2
  77.  
  78.  
  79. '// Form Moveing Api Calls
  80. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal Wparam As Long, lParam As Any) As Long
  81. Private Declare Function ReleaseCapture Lib "user32" () As Long
  82. Private Const WM_NCLBUTTONDOWN = &HA1
  83. Private Const WM_NCLBUTTONDBLCLK = &HA3
  84. Private Const WM_SETHOTKEY = &H32
  85. Private Const HTCAPTION = 2
  86.  
  87. '// End of Window Stuff.
  88.  
  89. Private Declare Function PtInRect Lib "user32" (lpRect As Rect, ByVal ptx As Long, ByVal pty As Long) As Long
  90. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  91. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  92. Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, lpRect As Rect, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
  93. Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As Rect) As Long
  94. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  95. Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal un1 As Long, ByVal un2 As Long) As Long
  96. Private Declare Function GetMenu Lib "user32" (ByVal Hwnd As Long) As Long
  97. Private Declare Function DrawCaption Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long, pcRect As Rect, ByVal un As Long) As Long
  98. Private Declare Function GetTextExtentPoint Lib "gdi32" Alias "GetTextExtentPointA" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSize As Size) As Long
  99. Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
  100. Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
  101. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  102. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  103. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  104. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  105. Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  106. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  107. Private Declare Function ScreenToClient Lib "user32" (ByVal Hwnd As Long, lpPoint As POINTAPI) As Long
  108. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
  109. Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
  110. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As Rect, ByVal edge As Long, ByVal grfFlags As Long) As Boolean
  111. Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
  112.  
  113. Private m_bRGBStart(1 To 3) As Integer   '/Gradent Fill Stuff
  114. Private m_oStartColor As OLE_COLOR
  115. Private m_bRGBEnd(1 To 3) As Integer
  116. Private m_oEndColor As OLE_COLOR
  117.  
  118.  
  119.  
  120. Private Const Button_Size = 15          '// Experiment with these.
  121. Private Const Frame_Size = 3            '// Experiment with these.
  122. Private Const Gradient_Finess = 100     '// Experiment with these.
  123.  
  124.  
  125. Private Exit_Rect As Rect               '// The Buttons . Mabey whe could put a fourth one in for an About dialog
  126. Private Maxi_Rect As Rect               '// By the Way does any one Know the Constants for the DrawFrameControl Cmd ??
  127. Private Resi_Rect As Rect
  128. Private Mini_Rect As Rect
  129. Private Title_Rect As Rect              '//The Title_Bar Rectangle
  130.  
  131.  
  132. Public Titlebar_FrameColor As Long
  133. Public Titlebar_BarColor As Long
  134. Public Titlebar_Txtfgcolor As Long
  135. 'Public Titlebar_Txtbkcolor As Long
  136.  
  137. Private Sub Grow()
  138. Dim Wr As Rect
  139. GetWindowRect Me.OwnerForm.Hwnd, Wr
  140. X = DeferWindowPos(Xt, Me.OwnerForm.Hwnd, Me.OwnerForm.Hwnd, Wr.Left, Wr.Top, Wr.Right + 1, Wr.Bottom + 1, SWP_NOMOVE)
  141. End Sub
  142.  
  143.  
  144. Sub Gui()
  145.  
  146.  
  147. Title_Rect.Left = 20                                 '// Set The Title Bars Dimensions.
  148. Title_Rect.Top = OwnerForm.ScaleTop
  149. Title_Rect.Right = OwnerForm.ScaleWidth
  150. Title_Rect.Bottom = 20
  151.  
  152.  
  153. OwnerForm.ScaleMode = vbPixels
  154.  
  155. Drawtitle Me.Titlebar_BarColor, OwnerForm.hdc
  156. Dim OldP As Long
  157. Dim Pen As Long
  158.  
  159. Pen = CreatePen(0, 3, Me.Titlebar_FrameColor)
  160. OldP = SelectObject(OwnerForm.hdc, Pen)
  161. Rectangle OwnerForm.hdc, Me.OwnerForm.ScaleLeft + 1, Me.OwnerForm.ScaleTop + 1, Me.OwnerForm.ScaleWidth - 1, Me.OwnerForm.ScaleHeight - 1
  162. SelectObject OwnerForm.hdc, OldP: DeleteObject Pen
  163.  
  164. Draw_Buttons
  165. End Sub
  166. Private Sub Draw_Buttons()
  167.  
  168. '//**********************************************************************************************
  169. Exit_Rect.Left = OwnerForm.ScaleWidth - Frame_Size - Button_Size
  170. Exit_Rect.Right = Exit_Rect.Left + Button_Size
  171. Exit_Rect.Top = Frame_Size + 1
  172. Exit_Rect.Bottom = Exit_Rect.Top + 15
  173. DrawFrameControl OwnerForm.hdc, Exit_Rect, 1, 8
  174. '//***********************************// Close Button *******************************************
  175.  
  176.  
  177. '//**********************************************************************************************
  178. Maxi_Rect.Left = OwnerForm.ScaleWidth - Frame_Size - Button_Size * 2
  179. Maxi_Rect.Right = Maxi_Rect.Left + Button_Size
  180. Maxi_Rect.Top = Frame_Size + 1
  181. Maxi_Rect.Bottom = Exit_Rect.Top + 15
  182.  
  183. If OwnerForm.WindowState = 2 Then
  184. DrawFrameControl OwnerForm.hdc, Maxi_Rect, 1, 7
  185. Else
  186. DrawFrameControl OwnerForm.hdc, Maxi_Rect, 1, 2
  187. End If
  188. '//************************************'// Maximize & Restore Button *****************************
  189.  
  190.  
  191.  
  192.  
  193.  
  194. '//**********************************************************************************************
  195. Mini_Rect.Left = OwnerForm.ScaleWidth - Frame_Size - Button_Size * 3
  196. Mini_Rect.Right = Mini_Rect.Left + Button_Size
  197. Mini_Rect.Top = Frame_Size + 1
  198. Mini_Rect.Bottom = Mini_Rect.Top + 15
  199. DrawFrameControl OwnerForm.hdc, Mini_Rect, 1, 1
  200. '//**********************************'// minimize Button ****************************************
  201.  
  202. End Sub
  203. Private Function Ptr(Hwnd As Long, Rect As Rect) As Boolean
  204. Dim pnt As POINTAPI
  205. nRet = GetCursorPos(pnt)
  206. ScreenToClient Hwnd, pnt
  207. If PtInRect(Rect, pnt.X, pnt.Y) <> 0 Then Ptr = True: Exit Function
  208. Ptr = False
  209. End Function
  210.  
  211. Private Sub Drawtitle(Color As Long, hdc As Long)
  212. '// Do the Gradient.
  213. Dim Tr As Rect
  214. Dim bRGB(1 To 3) As Integer, dR(1 To 3) As Double '//   Fine tuned Gradient fill
  215.     
  216.     bRGB(1) = m_bRGBStart(1)
  217.     bRGB(2) = m_bRGBStart(2)
  218.     bRGB(3) = m_bRGBStart(3)
  219.     dR(1) = m_bRGBEnd(1) - m_bRGBStart(1)
  220.     dR(2) = m_bRGBEnd(2) - m_bRGBStart(2)
  221.     dR(3) = m_bRGBEnd(3) - m_bRGBStart(3)
  222.  
  223. Xwdth = OwnerForm.Width \ Screen.TwipsPerPixelX
  224. Increment = Xwdth \ Gradient_Finess: If Increment = 0 Then Increment = 1
  225.  
  226. For X = 1 To Xwdth Step Increment
  227. Tr.Left = Tr.Right
  228. Tr.Right = Tr.Left + Increment
  229. Tr.Bottom = 20
  230. Tr.Top = Form1.ScaleTop + 3
  231.  
  232. B = CreateSolidBrush((bRGB(3) * &H10000 + bRGB(2) * &H100& + bRGB(1)))
  233. FillRect hdc, Tr, B
  234. DeleteObject B
  235.  
  236. bRGB(1) = m_bRGBStart(1) + dR(1) * (Xwdth - X) / Xwdth
  237. bRGB(2) = m_bRGBStart(2) + dR(2) * (Xwdth - X) / Xwdth
  238. bRGB(3) = m_bRGBStart(3) + dR(3) * (Xwdth - X) / Xwdth
  239.         
  240. Next X
  241. '// Do the Gradient.
  242.  
  243.  
  244. '// Draw the ICON
  245. B = CreateSolidBrush(Color)
  246. DrawIconEx hdc, 3, 3, Form1.Icon, 15, 17, 0, B, 0
  247. DeleteObject B
  248. '// Draw the ICON
  249.  
  250. Printf3 OwnerForm.Caption, 3, 20, hdc, Me.Titlebar_Txtfgcolor, 0, True
  251.  
  252.  
  253. '/
  254. Tr.Left = 3
  255. Tr.Right = Form1.ScaleWidth
  256. Tr.Bottom = Tr.Bottom + 3
  257. DrawEdge OwnerForm.hdc, Tr, EDGE_BUMP, BF_BOTTOM
  258.  
  259.  
  260. End Sub
  261.  
  262. Sub Printf3(Txt As String, ByVal Xpos, ByVal Ypos, hdc As Long, Color As Long, bkC As Long, Trns As Boolean)
  263. Dim R As Rect
  264. SetTextColor hdc, Color
  265. SetBkColor hdc, bkC
  266. Linc = Ypos
  267. R.Top = Xpos
  268.  
  269. For X = 1 To Len(Txt)
  270.  
  271. CharWidth = GetText_Width(Mid(Txt, X, 1))
  272. CharHeight = GetText_Height(Mid(Txt, X, 1))
  273. R.Left = Linc
  274. R.Right = Linc + CharWidth
  275. R.Bottom = R.Top + CharHeight
  276. If Trns = False Then ExtTextOut hdc, R.Left, R.Top, ETO_OPAQUE, R, Mid(Txt, X, 1), 1, 0
  277. If Trns = True Then ExtTextOut hdc, R.Left, R.Top, ETO_CLIPPED, R, Mid(Txt, X, 1), 1, 0
  278. Linc = Linc + CharWidth
  279.  
  280. Next X
  281. End Sub
  282.  
  283.  
  284.  
  285.  
  286. Private Sub SinkCb()
  287. DrawEdge Form1.hdc, Exit_Rect, BDR_SUNKEN, BF_RECT
  288. End Sub
  289. Private Sub SinkMb()
  290. DrawEdge Form1.hdc, Maxi_Rect, BDR_SUNKEN, BF_RECT
  291. End Sub
  292. Private Sub Sinkmnb()
  293. DrawEdge Form1.hdc, Mini_Rect, BDR_SUNKEN, BF_RECT
  294. End Sub
  295.  
  296. Sub Mouse_Down()
  297. If Ptr(OwnerForm.Hwnd, Title_Rect) = False Then Exit Sub
  298.  
  299. If Ptr(OwnerForm.Hwnd, Exit_Rect) = True Then SinkCb: Exit Sub
  300. If Ptr(OwnerForm.Hwnd, Mini_Rect) = True Then Sinkmnb: Exit Sub
  301. If Ptr(OwnerForm.Hwnd, Maxi_Rect) = True Then SinkMb: Exit Sub
  302.  
  303.  
  304. If OwnerForm.WindowState = 0 Then ReleaseCapture: SendMessage OwnerForm.Hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0: Exit Sub
  305.  
  306. End Sub
  307.  
  308.  
  309. Sub Mouse_Up()
  310. 'If Ptr(OwnerForm.Hwnd, Title_Rect) = False Then Exit Sub
  311. If Ptr(OwnerForm.Hwnd, Exit_Rect) = True Then Unload OwnerForm: Exit Sub
  312.  
  313. If Ptr(OwnerForm.Hwnd, Maxi_Rect) = True Then
  314. If OwnerForm.WindowState = 0 Then OwnerForm.WindowState = 2: OwnerForm.Refresh: Exit Sub
  315. If OwnerForm.WindowState = 2 Then OwnerForm.WindowState = 0: OwnerForm.Refresh: Exit Sub
  316. Exit Sub
  317. End If
  318.  
  319. If Ptr(OwnerForm.Hwnd, Mini_Rect) = True Then Form1.WindowState = 1
  320. Draw_Buttons
  321.  
  322. End Sub
  323.  
  324.  
  325. Private Sub StartColor(ByVal oColor As OLE_COLOR)
  326. Dim lColor As Long
  327.     If (m_oStartColor <> oColor) Then
  328.         m_oStartColor = oColor
  329.         OleTranslateColor oColor, 0, lColor
  330.         m_bRGBStart(1) = lColor And &HFF&
  331.         m_bRGBStart(2) = ((lColor And &HFF00&) \ &H100)
  332.         m_bRGBStart(3) = ((lColor And &HFF0000) \ &H10000)
  333.     End If
  334.     
  335. End Sub
  336.  
  337. Private Sub EndColor(ByVal oColor As OLE_COLOR)
  338. Dim lColor As Long
  339.     If (m_oEndColor <> oColor) Then
  340.         m_oEndColor = oColor
  341.         OleTranslateColor oColor, 0, lColor
  342.         m_bRGBEnd(1) = lColor And &HFF&
  343.         m_bRGBEnd(2) = ((lColor And &HFF00&) \ &H100)
  344.         m_bRGBEnd(3) = ((lColor And &HFF0000) \ &H10000)
  345.     End If
  346. End Sub
  347.  
  348. Private Sub Class_Initialize()
  349.  
  350. 'Ill Put more support for these l8tr
  351. 'like make them propertys or something
  352. StartColor vbBlack
  353. EndColor vbCyan
  354.  
  355. End Sub
  356. Private Function GetText_Width(Txt As String) As Long
  357. Dim S As Size
  358. X = GetTextExtentPoint(Form1.hdc, Txt, 1, S)
  359. GetText_Width = S.cx
  360. End Function
  361. Private Function GetText_Height(Txt As String) As Long
  362. Dim S As Size
  363. X = GetTextExtentPoint(Form1.hdc, Txt, 1, S)
  364. GetText_Height = S.cy
  365. End Function
  366.  
  367.